home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / paint.zip / PTFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1987-11-18  |  5KB  |  138 lines
  1. {  This is a set of file-handling utilities,
  2.   designed for PAINT, but perhaps with wider applicability  }
  3.  
  4. function getname ( oldname : filename; code : integer ) : filename;
  5.   {  Queries for a file name, announcing "oldname" as default.
  6.      If code > 0, file must already exist.
  7.      Returns the file name. }
  8.  
  9.     var    newname : filename;
  10.            inchar : char;
  11.            fprom : prompt;
  12.            filemsg : string [20];
  13.            fname : text;
  14.     begin
  15.         inchar:=' ';
  16.         newname:=oldname;
  17.         repeat
  18.             ClrWin (2);
  19.             window (2,'Current File Name');
  20.             window (2,newname);
  21.             window (2,'NAME OF FILE?');
  22.             GoToXY (RIGHT-WinWidth, linecount [2]);
  23.             ReadLn (newname);
  24.             if newname='' then  newname:=oldname;
  25.             Assign (fname, newname);
  26.  
  27.             {$I-}  reset (fname)  {$I+} ;
  28.             if  IOresult=0 then
  29.             begin
  30.                 filemsg := 'File exists. OK?';
  31.                 close (fname);
  32.             end
  33.             else begin
  34.                 if code=0 then filemsg:= 'New file. OK?'
  35.                 else           filemsg:= 'No such file.'
  36.             end;
  37.  
  38.             inchar := ' ';
  39.                 ClrWin (2);
  40.                 window (2,newname);
  41.                 window (2,filemsg);
  42.             if not (filemsg='No such file.') then
  43.             begin
  44.                 window (2,'(Y/N)');
  45.                 GoToXY (RIGHT-WinWidth+6, linecount [2]-1);
  46.                 read (kbd, inchar);
  47.             end
  48.             else Delay (3000);
  49.  
  50.         until (inchar='y') or (inchar='Y');
  51.  
  52.         ClrWin (2);
  53.         getname := newname;
  54.     end;
  55.  
  56. procedure load (var oldname : filename; var screen : PagArr; xlate : palette);
  57.     const  abortmsg : prompt = ('NO SUCH FILE','ABORTING LOAD','','','');
  58.     var    i,j, last : integer;
  59.            pline : string [132];
  60.            pfile : text;
  61.            newname : filename;
  62.     begin
  63.         ClrWin (2);
  64.         window (2,'Current File Name');
  65.         window (2,oldname);
  66.         window (2,'NAME OF FILE?');
  67.         GoToXY (RIGHT-WinWidth, linecount [2]);
  68.         ReadLn (newname);
  69.         if newname='' then  newname:=oldname;
  70.  
  71.         assign (pfile, newname);
  72.         {$I-}  reset (pfile)  {$I+} ;
  73.         if  not (IOresult=0) then   (* no such file *)
  74.             flash (abortmsg)
  75.         else begin       (* load line-by-line from pfile *)
  76.             (* start by clearing old screen *)
  77.             for j:=0 to page do  for i:=0 to line do  screen [i,j] := 1;
  78.  
  79.             i:=0;      (* line counter *)
  80.             while not EOF (pfile) do
  81.             begin
  82.                 readln (pfile, pline);
  83.                 last := length (pline) -1;
  84.  
  85.                 (* construct a line of the screen *)
  86.                 for j:=0 to last do
  87.                     screen [j,i] := pos (pline [j+1], xlate);
  88.                               (* use "xlate" to get numeric brush values *)
  89.                 if last < line-1 then    (* fill rest of line with blanks *)
  90.                     for j:=last+1 to line-1 do   screen [j,i] := 1;
  91.  
  92.                i := i + 1;
  93.             end;
  94.  
  95.             close (pfile);
  96.             oldname := newname;
  97.         end;
  98.     end;
  99.  
  100.  
  101. procedure save (fname : filename; screen : PagArr; xlate : palette);
  102.     var    i,j, last : integer;
  103.            pline : string [132];
  104.            pfile : text;
  105.            reassure : prompt;
  106.     begin
  107.         if fname='CON:' then
  108.             begin   Alfa; ClrScr;   end;
  109.         assign (pfile, fname);
  110.         rewrite (pfile);
  111.         for i:=0 to page-1 do    (* for each line in turn *)
  112.         begin
  113.             (* find last non-blank on line *)
  114.             last := line-1;
  115.             while (screen [last,i] < 2) and (last >= 0) do
  116.                 last := last - 1;
  117.  
  118.             (* construct a print line *)
  119.             pline := '';
  120.             if last >=0 then
  121.               for j:=0 to last do
  122.                 pline := concat (pline, xlate [screen [j,i]]);
  123.  
  124.             if (fname='CON:') and (line=80)
  125.                 then   write   (pfile, pline)   (* CR takes the 81st col *)
  126.                 else   writeln (pfile, pline);
  127.         end;
  128.         close (pfile);
  129.         if fname='CON:' then repeat until KeyPressed
  130.             else if not (fname='LST:') then
  131.             begin
  132.                 reassure [1] := fname;
  133.                 reassure [2] := 'FILE SAVED.';
  134.                 reassure [3] := ''; reassure [4] := ''; reassure [5] := '';
  135.                 flash (reassure);
  136.             end;
  137.     end;
  138.